perm filename DEBUG.SAI[PNT,HE] blob
sn#572749 filedate 1981-03-11 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00007 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 ENTRY
C00018 00003 ! dbinit, rtn10,rtn10offset,rstrpos
C00022 00004 ! break_at, unbreak_at, breakdebug
C00024 00005 ! nocrlf, showtext, textdebug, trapsdebug
C00027 00006 ! !!go, p!!sstep,p!!xstep,haltdebug
C00034 00007 ! pbreak,debugloop
C00050 ENDMK
C⊗;
ENTRY;
BEGIN "DEBUG"
DEFINE $DEBUG=TRUE;
REQUIRE "HEADER.SAI" SOURCE_FILE;
! !DEBUG is true when the system is in debugmode (after DEBUGON)
!!DEBUGGING is true when the system is actually debugging
$$DEBUG is the pointer to the DBEXPR record of the current expression ;
INTEGER NEWPCDBUF; ! new pcode buffer for pcode generated/interpreted
while debugging;
INTEGER $COORD,$OFFSET; ! coord. and offset of the next instruction to be
executed;
RPTR(SYMBOL)$WHERE; ! rptr to the procedure (used if $OFFSET≠0);
DEFINE #BMARK= '240000; ! mark of the beginning of instruction;
DEFINE #EMARK= '220000; ! ending mark;
DEFINE #RESTART=0,
#CONTINUE=1,
#QUIT=2; ! used in debugloop to know what to do;
PROCEDURE SETDBEXPR(RPTR(DBEXPR)DBR;INTEGER INSTR,TXTINI,HOWLONG,PROCREF);
BEGIN
INTEGER ARRAY TXTPOS,COORD[1:1];RPTR (BLOCKREC) ARRAY BLOCK[1:1];
TXTPOS[1]←(TXTINI ASH 18) + HOWLONG;
COORD[1]←(INSTR ASH 13)+(PROCREF ASH 1);
BLOCK[1]←CURBLOCK;
MEMORY[LOCATION(txtpos)] ↔ MEMORY[LOCATION(DBEXPR:txtpos[DBR])];
MEMORY[LOCATION(coord)] ↔ MEMORY[LOCATION(DBEXPR:coord[DBR])];
MEMORY[LOCATION(block)] ↔ MEMORY[LOCATION(DBEXPR:block[DBR])];
DBEXPR:#COORD[DBR]←1;
END;
INTERNAL RPTR(EXPR$) PROCEDURE MARK(INTEGER COORD,TXTINI,HOWLONG);
BEGIN
RPTR (EXPR$) ARRAY TEMP[1:3];INTEGER OFF;
OFF←IF CURPROC THEN IF $COMPILE THEN $SYMOFF ELSE $SYMOFF-1 ELSE 0;
TEMP[1]← EXPR$2(#BMARK LOR OFF,COORD);
TEMP[2]←$$PCODE;
TEMP[3]←EXPR$2(#EMARK LOR OFF,COORD);
! refproc is the rptr to teh procedure being referenced. It's used for the
TRAPS instruction;
SETDBEXPR(EXPR$:DBEXPR[TEMP[3]],COORD,TXTINI,HOWLONG,
IF REFPROC THEN SYMBOL:OFFSET[REFPROC] ELSE 0);
REFPROC←NULL_RECORD;
RETURN ($AAPPEND(TEMP));
END;
! The fields of the record DBEXPR are:
#COORD = max number of coordinate in the POINTY program
BODY = string with the symbolic text of thh program
COORD = array [1:#coord] containing
000000000000000000000 00000000000000 0
coord offset trap
(>0 no breakpoint, =1 breakpoint)
TXTPOS = array [1:#coord] containing
000000000000000000 000000000000000000
txtpos howlong
PCDPOS = array [1:#coord] containing
000000000000000000 000000000000000000
pcdpos howlong
BLOCK = array [1:#coord] containing
000000000000000000000000000000000000
pointer to the block
;
! dbinit, rtn10,rtn10offset,rstrpos;
INTERNAL PROCEDURE DBINIT;
BEGIN
! create $$DEBUG from $$pcode, order it with respect to coord numbers,
and save pcdpos;
INTEGER PCSIZE,SSIZE;
PCSIZE←EXPR$:#BODY[$$PCODE];
SSIZE←DBEXPR:#COORD[($$DEBUG←EXPR$:DBEXPR[$$PCODE])];
BEGIN "a"
INTEGER ARRAY PCDPOS,TXTPOS,COORD,PCDEND[1:SSIZE];
RPTR(BLOCKREC)ARRAY BLOCK[1:SSIZE];INTEGER I,J,K;
J←0;
! construct pcdpos looking at the pcode and finding the
beginning and ending marks;
FOR I←1 STEP 1 UNTIL PCSIZE DO
BEGIN
IF EXPR$:BODY[$$PCODE][I]≥ #BMARK THEN PCDPOS[J←J+1]←I ELSE
IF #EMARK ≤ EXPR$:BODY[$$PCODE][I]< #BMARK
THEN PCDEND[EXPR$:BODY[$$PCODE][I+1]]←I+1;
END;
IF J≠SSIZE THEN ERROR("DEBUG INIT error");
! order txtpos, coord, and block in increasing order of coordinate numbers;
FOR I←1 STEP 1 UNTIL SSIZE DO
BEGIN
J← DBEXPR:COORD[$$DEBUG][I] ASH -13;
TXTPOS[J]←DBEXPR:TXTPOS[$$DEBUG][I];
BLOCK[J]←DBEXPR:BLOCK[$$DEBUG][I];
COORD[J]←DBEXPR:COORD[$$DEBUG][I];
PCDEND[I]←PCDEND[I]-PCDPOS[J]+1; ! length of pcode;
PCDPOS[J]←(PCDPOS[J] ASH 18)+PCDEND[I];
END;
MEMORY[LOCATION(COORD)] ↔ MEMORY[LOCATION(DBEXPR:COORD[$$DEBUG])];
MEMORY[LOCATION(TXTPOS)] ↔ MEMORY[LOCATION(DBEXPR:TXTPOS[$$DEBUG])];
MEMORY[LOCATION(BLOCK)] ↔ MEMORY[LOCATION(DBEXPR:BLOCK[$$DEBUG])];
MEMORY[LOCATION(PCDPOS)] ↔ MEMORY[LOCATION(DBEXPR:PCDPOS[$$DEBUG])];
END "a";
DBEXPR:BODY[$$DEBUG]←$CLNSAVE;
IF CURPROC THEN PROC:DBEXPR[SYMBOL:OBJECT[CURPROC]]←$$DEBUG;
END;
! TRUE if before the execution of the pcode a return to the 10 is required.
This happens for compound statements (unless they are procedures) and
when the sytem is not debugging;
INTERNAL BOOLEAN PROCEDURE RTN10;
RETURN(!DEBUG AND ¬!!DEBUGGING AND ¬CURPROC
AND ((DBEXPR:COORD[$$DEBUG][1] LAND '7777) OR
DBEXPR:#COORD[$$DEBUG]>1));
! return the restarting position in pcode (in words) relative to the
beginning of pcode or of procedure pcode;
! remember to take care of PHALT,offset,coord in front of instruction
or of the declaration of the procedure;
INTEGER PROCEDURE RSTRPOS(RPTR(DBEXPR) DEBG;INTEGER COORD,OFFSET);
BEGIN
IF COORD>DBEXPR:#COORD[DEBG] THEN ERROR(":: coordinate too big.");
IF COORD=1 AND OFFSET THEN ERROR("can't break first instruction of proc.");
RETURN((DBEXPR:PCDPOS[DEBG][COORD] ASH -18) -1 +
(IF OFFSET THEN -4 ELSE 3));
END;
! break_at, unbreak_at, breakdebug;
RPTR(EXPR$)PROCEDURE BREAK_AT(INTEGER OFFSET,POS11,COORD;RPTR(DBEXPR)DEBG);
BEGIN
$$PCODE←EXPR$3(XPBREAK,OFFSET,POS11);
DBEXPR:COORD[DEBG][COORD]←DBEXPR:COORD[DEBG][COORD]+1;
END;
RPTR(EXPR$)PROCEDURE UNBREAK_AT(INTEGER OFFSET,POS11,COORD;RPTR(DBEXPR)DEBG);
BEGIN
IF (DBEXPR:COORD[DEBG][COORD] LAND 1)= 0
THEN PRINT("non_existing TRAP",CRLF)
ELSE BEGIN
DBEXPR:COORD[DEBG][COORD]←DBEXPR:COORD[DEBG][COORD]-1;
$$PCODE←EXPR$3(XUBREAK,OFFSET,POS11);
END;
END;
INTERNAL PROCEDURE BREAKDEBUG(BOOLEAN DISCRIMINATOR(TRUE));
BEGIN
INTEGER COORD,OFFSET,POS11;RPTR(SYMBOL)WHERE;rptr(dbexpr)debg;
WORD_READ("(");if WHERE←PROCNAME_READ then WORD_READ(",");
COORD←GT_ZERO_READ;WORD_READ(")");
DEBG← IF WHERE THEN PROC:DBEXPR[SYMBOL:OBJECT[WHERE]] ELSE $$DEBUG;
IF DEBG=NULL_RECORD THEN ERROR("cannot break "&symbol:pname[where]);
OFFSET← IF WHERE THEN SYMBOL:OFFSET[WHERE] ELSE 0;
POS11←RSTRPOS(DEBG, COORD, OFFSET); ! coordinate of the pcode (in word);
IF COORD > DBEXPR:#COORD[DEBG]
THEN ERROR(COORD&": non existent coordinate !")
ELSE IF DISCRIMINATOR THEN BREAK_AT(OFFSET,POS11,COORD,DEBG)
ELSE UNBREAK_AT(OFFSET,POS11,COORD,DEBG);
END;
! nocrlf, showtext, textdebug, trapsdebug;
RECURSIVE STRING PROCEDURE NOCRLF(STRING S);
RETURN(IF LENGTH(S)<2 THEN S
ELSE IF EQU(S[1 FOR 2],CRLF) THEN NOCRLF(S[3 TO ∞])
ELSE S);
PROCEDURE SHOWTEXT(RPTR(SYMBOL)WHERE;INTEGER LOW, UP_COUNT(0));
BEGIN
INTEGER UPPER,IC,maxc;
RPTR(DBEXPR)DEBG;STRING BODY;
UPPER← IF LOW ≤ UP_COUNT THEN UP_COUNT
ELSE IF UP_COUNT=0 THEN LOW ELSE LOW+UP_COUNT-1;
DEBG← IF WHERE THEN PROC:DBEXPR[SYMBOL:OBJECT[WHERE]] ELSE $$DEBUG;
IF DEBG=NULL_RECORD THEN ERROR("cannot show text of "&symbol:pname[where]);
BODY ← DBEXPR:BODY[DEBG];
IF UPPER > (MAXC←DBEXPR:#COORD[DEBG])
THEN BEGIN
PRINT(UPPER,":: coordinate is too big.");
UPPER←MAXC;
END;
PRINT(CRLF);
FOR IC←LOW STEP 1 UNTIL UPPER DO
PRINT(IF WHERE THEN SYMBOL:PNAME[WHERE]&" " ELSE "",
IC,": ",NOCRLF(BODY[(DBEXPR:TXTPOS[DEBG][IC] ASH -18)+1
TO IF IC≠MAXC THEN (DBEXPR:TXTPOS[DEBG][IC+1] ASH -18)
ELSE ∞]),CRLF)
END;
INTERNAL PROCEDURE TEXTDEBUG;
BEGIN
INTEGER LOW,UPPER;RPTR(SYMBOL) WHERE;
IF IS_TOKEN("(")
THEN BEGIN
IF WHERE←PROCNAME_READ THEN WORD_READ(",");
LOW←GT_ZERO_READ; WORD2_READ(",",")","TEXT");
IF TOKEN="," THEN BEGIN UPPER←GT_ZERO_READ; WORD_READ(")");END
ELSE UPPER←0;
END
ELSE BEGIN LOW←$COORD;UPPER←0;WHERE←$WHERE;END;
SHOWTEXT(WHERE,LOW,UPPER);
END;
INTERNAL RECURSIVE PROCEDURE TRAPSDEBUG(RPTR(SYMBOL) WHERE(NULL_RECORD));
BEGIN
INTEGER I,N,OFF;RPTR(DBEXPR) DEBG;
DEBG← IF WHERE THEN PROC:DBEXPR[SYMBOL:OBJECT[WHERE]] ELSE $$DEBUG;
IF DEBG=NULL_RECORD THEN RETURN;
N←DBEXPR:#COORD[DEBG];
FOR I←1 STEP 1 UNTIL N DO
BEGIN "TR"
IF (DBEXPR:COORD[DEBG][I] LAND 1)THEN SHOWTEXT(WHERE, I);
IF OFF←(DBEXPR:COORD[DEBG][I] LAND '17776) ASH -1
THEN TRAPSDEBUG(CHECKOFF (OFF));
END "TR";
END;
! !!go, p!!sstep,p!!xstep,haltdebug;
INTERNAL PROCEDURE HALTDEBUG;
BEGIN
$$PCODE←EXPR$3(XPHALT,IF CURPROC THEN SYMBOL:OFFSET[CURPROC] ELSE 0,INSTR_N);
END;
! All those procedures are directly executed and then the program on the 11
is restarted;
INTERNAL PROCEDURE RESTARTDEBUG(BOOLEAN DISCRIMINATOR(TRUE));
BEGIN
IF $OFFSET
THEN ERROR("cannot "&(IF DISCRIMINATOR THEN "RESTART" ELSE "QUIT")
&" inside a procedure")
ELSE $EXECUTE(EXPR$1(XPRESTART));
END;
PROCEDURE P!!GO(INTEGER COORD,OFFSET);
$EXECUTE(EXPR$2(XCNTRL,CNTRG));
PROCEDURE P!!STEP(INTEGER COORD,OFFSET);
$EXECUTE(EXPR$2(XCNTRL,CNTRS));
PROCEDURE P!!GSTEP(INTEGER COORD,OFFSET);
$EXECUTE(EXPR$2(XCNTRL,CNTRX));
! pbreak,debugloop;
INTERNAL PROCEDURE PBREAK;
BEGIN
INTEGER I,OFFSET;
SETPCDBUF(IF ¬!!DEBUGGING THEN (NEWPCDBUF← OLDPCDBUF+PSIZE*2)
ELSE NEWPCDBUF);
$OFFSET←GETIN;$COORD←GETIN;
IF NOT !DEBUG
THEN PRINT("HALT at : "&CVS($COORD)&
(if $offset then " offset "&CVS($OFFSET) ELSE "")&CRLF)
ELSE SHOWTEXT($where←(IF $OFFSET THEN CHECKOFF($OFFSET) ELSE NULL_RECORD),
$COORD);
DEBUGLOOP;
END;
INTERNAL PROCEDURE DEBUGLOOP;
BEGIN
STRING S;INTEGER CONTROL;
!!DEBUGGING←TRUE;CONTROL←#CONTINUE;
DO BEGIN
PRINT(CRLF,":*: ");ASKUSER; S← _SKIP_ ;
IF S="G" OR S="g" THEN BEGIN P!!GO($COORD,$OFFSET);DONE;END;
IF S="X" OR S="x"
THEN IF ¬!DEBUG
THEN BEGIN PRINT("Only ↑G can help you!");CONTINUE;end
ELSE BEGIN P!!GSTEP($COORD,$OFFSET);DONE;END;
IF S="S" OR S="s"
THEN IF ¬!DEBUG
THEN BEGIN PRINT("Only ↑G can help you!");CONTINUE;end
ELSE BEGIN P!!STEP($COORD,$OFFSET);DONE;END;
STOKEN← FALSE;
GTOKEN;
IF EQU(TOKEN,"!!GO") THEN BEGIN P!!GO($COORD,$OFFSET);DONE;END;
IF ¬!DEBUG THEN BEGIN PRINT("Only !!go can help you!");CONTINUE;END;
IF EQU(TOKEN,"!!GSTEP") THEN BEGIN P!!GSTEP($COORD,$OFFSET);DONE;END;
IF EQU(TOKEN,"!!STEP") THEN BEGIN P!!STEP($COORD,$OFFSET);DONE;END;
IF EQU(TOKEN,"RESTART") THEN BEGIN RESTARTDEBUG;CONTROL←#RESTART;DONE;END;
IF EQU(TOKEN,"QUIT") THEN BEGIN RESTARTDEBUG(FALSE);CONTROL←#QUIT;DONE;END;
STOKEN←TRUE;
PREPARSE;
CURBLOCK←DBEXPR:BLOCK[IF $WHERE THEN PROC:DBEXPR[symbol:object[$WHERE]]
ELSE $$DEBUG][$COORD];
PARSE; ! parses the instruction;
CHKESC_I; ! check if escape_I was typed ;
IF NOT FINAL THEN SEMICOL_READ;
IF !LINE THEN PRINT(CRLF,"LAST STATEMENT: ",$CLNSAVE);
END
UNTIL FALSE;
CASE CONTROL OF BEGIN
[#CONTINUE] CONTNU11;
[#RESTART] RSTR11;
[#QUIT] BEGIN END
END;
END;
END "DEBUG"